home *** CD-ROM | disk | FTP | other *** search
/ Linux Cubed Series 3: Developer Tools / Linux Cubed Series 3 - Developer Tools.iso / devel / lang / lisp / stk-3.002 / stk-3 / STk-3.1 / Tk / generic / tkConsole.c < prev    next >
Encoding:
C/C++ Source or Header  |  1996-05-31  |  14.6 KB  |  544 lines
  1. /* 
  2.  * tkConsole.c --
  3.  *
  4.  *    This file implements a Tcl console for systems that may not
  5.  *    otherwise have access to a console.  It uses the Text widget
  6.  *    and provides special access via a console command.
  7.  *
  8.  * Copyright (c) 1995-1996 Sun Microsystems, Inc.
  9.  *
  10.  * See the file "license.terms" for information on usage and redistribution
  11.  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  12.  *
  13.  * SCCS: @(#) tkConsole.c 1.37 96/04/20 15:17:32
  14.  */
  15.  
  16. #include "tkInt.h"
  17.  
  18. /*
  19.  * A data structure of the following type holds information for each console
  20.  * which a handler (i.e. a Tcl command) has been defined for a particular
  21.  * top-level window.
  22.  */
  23.  
  24. typedef struct ConsoleInfo {
  25.     Tcl_Interp *consoleInterp;    /* Interpreter for the console. */
  26.     Tcl_Interp *interp;        /* Interpreter to send console commands. */
  27. } ConsoleInfo;
  28.  
  29. static Tcl_Interp *gStdoutInterp = NULL;
  30.  
  31. /*
  32.  * Forward declarations for procedures defined later in this file:
  33.  */
  34.  
  35. static int    ConsoleCmd _ANSI_ARGS_((ClientData clientData,
  36.             Tcl_Interp *interp, int argc, char **argv));
  37. static void     ConsoleDeleteProc _ANSI_ARGS_((ClientData clientData));
  38. static void    ConsoleEventProc _ANSI_ARGS_((ClientData clientData,
  39.             XEvent *eventPtr));
  40. static int    InterpreterCmd _ANSI_ARGS_((ClientData clientData,
  41.             Tcl_Interp *interp, int argc, char **argv));
  42.  
  43. static int        ConsoleInput _ANSI_ARGS_((ClientData instanceData,
  44.                 Tcl_File inFile, char *buf, int toRead,
  45.                 int *errorCode));
  46. static int        ConsoleOutput _ANSI_ARGS_((ClientData instanceData,
  47.                 Tcl_File outFile, char *buf, int toWrite,
  48.                 int *errorCode));
  49. static int        ConsoleClose _ANSI_ARGS_((ClientData instanceData,
  50.                 Tcl_Interp *interp, Tcl_File inFile, 
  51.                 Tcl_File outFile));
  52.  
  53. /*
  54.  * This structure describes the channel type structure for file based IO:
  55.  */
  56.  
  57. static Tcl_ChannelType consoleChannelType = {
  58.     "console",            /* Type name. */
  59.     NULL,            /* Always non-blocking.*/
  60.     ConsoleClose,        /* Close proc. */
  61.     ConsoleInput,        /* Input proc. */
  62.     ConsoleOutput,        /* Output proc. */
  63.     NULL,            /* Seek proc. */
  64.     NULL,            /* Set option proc. */
  65.     NULL,            /* Get option proc. */
  66. };
  67.  
  68. /*
  69.  *----------------------------------------------------------------------
  70.  *
  71.  * TkConsoleCreate --
  72.  *
  73.  *     Create the console channels and install them as the standard
  74.  *     channels.  All I/O will be discarded until TkConsoleInit is
  75.  *     called to attach the console to a text widget.
  76.  *
  77.  * Results:
  78.  *    None.
  79.  *
  80.  * Side effects:
  81.  *    Creates the console channel and installs it as the standard
  82.  *    channels.
  83.  *
  84.  *----------------------------------------------------------------------
  85.  */
  86.  
  87. void
  88. TkConsoleCreate()
  89. {
  90.     Tcl_Channel consoleChannel;
  91.     Tcl_File inFile, outFile, errFile;
  92.  
  93.     inFile = Tcl_GetFile((ClientData) 0, 0);
  94.     outFile = Tcl_GetFile((ClientData) 1, 0);
  95.     errFile = Tcl_GetFile((ClientData) 2, 0);
  96.  
  97.     consoleChannel = Tcl_CreateChannel(&consoleChannelType, "console0",
  98.         inFile, NULL, (ClientData) NULL);
  99.     if (consoleChannel != NULL) {
  100.     Tcl_SetChannelOption(NULL, consoleChannel, "-translation", "lf");
  101.     Tcl_SetChannelOption(NULL, consoleChannel, "-buffering", "none");
  102.     }
  103.     Tcl_SetStdChannel(consoleChannel, TCL_STDIN);
  104.     consoleChannel = Tcl_CreateChannel(&consoleChannelType, "console1",
  105.         NULL, outFile, (ClientData) NULL);
  106.     if (consoleChannel != NULL) {
  107.     Tcl_SetChannelOption(NULL, consoleChannel, "-translation", "lf");
  108.     Tcl_SetChannelOption(NULL, consoleChannel, "-buffering", "none");
  109.     }
  110.     Tcl_SetStdChannel(consoleChannel, TCL_STDOUT);
  111.     consoleChannel = Tcl_CreateChannel(&consoleChannelType, "console2",
  112.         NULL, errFile, (ClientData) NULL);
  113.     if (consoleChannel != NULL) {
  114.     Tcl_SetChannelOption(NULL, consoleChannel, "-translation", "lf");
  115.     Tcl_SetChannelOption(NULL, consoleChannel, "-buffering", "none");
  116.     }
  117.     Tcl_SetStdChannel(consoleChannel, TCL_STDERR);
  118. }
  119.  
  120. /*
  121.  *----------------------------------------------------------------------
  122.  *
  123.  * TkConsoleInit --
  124.  *
  125.  *    Initialize the console.  This code actually creates a new
  126.  *    application and associated interpreter.  This effectivly hides
  127.  *    the implementation from the main application.
  128.  *
  129.  * Results:
  130.  *    None.
  131.  *
  132.  * Side effects:
  133.  *    A new console it created.
  134.  *
  135.  *----------------------------------------------------------------------
  136.  */
  137.  
  138. int 
  139. TkConsoleInit(interp)
  140.     Tcl_Interp *interp;            /* Interpreter to use for prompting. */
  141. {
  142.     Tcl_Interp *consoleInterp;
  143.     ConsoleInfo *info;
  144.     Tk_Window mainWindow = Tk_MainWindow(interp);
  145. #ifdef MAC_TCL
  146.     static char initCmd[] = "source -rsrc {Console}";
  147. #else
  148.     static char initCmd[] = "source $tk_library/console.tcl";
  149. #endif
  150.     
  151.     consoleInterp = Tcl_CreateInterp();
  152.     if (consoleInterp == NULL) {
  153.     goto error;
  154.     }
  155.     
  156.     /*
  157.      * Initialized Tcl and Tk.
  158.      */
  159.  
  160.     if (Tcl_Init(consoleInterp) != TCL_OK) {
  161.     goto error;
  162.     }
  163.     if (Tk_Init(consoleInterp) != TCL_OK) {
  164.     goto error;
  165.     }
  166.     gStdoutInterp = interp;
  167.     
  168.     /* 
  169.      * Add console commands to the interp 
  170.      */
  171.     info = (ConsoleInfo *) ckalloc(sizeof(ConsoleInfo));
  172.     info->interp = interp;
  173.     info->consoleInterp = consoleInterp;
  174.     Tcl_CreateCommand(interp, "console", ConsoleCmd, (ClientData) info,
  175.         (Tcl_CmdDeleteProc *) ConsoleDeleteProc);
  176.     Tcl_CreateCommand(consoleInterp, "interp", InterpreterCmd,
  177.         (ClientData) info, (Tcl_CmdDeleteProc *) NULL);
  178.  
  179.     Tk_CreateEventHandler(mainWindow, StructureNotifyMask, ConsoleEventProc,
  180.         (ClientData) info);
  181.  
  182.     Tcl_Preserve((ClientData) consoleInterp);
  183.     if (Tcl_Eval(consoleInterp, initCmd) == TCL_ERROR) {
  184.     /* goto error; -- no problem for now... */
  185.     printf("Eval error: %s", consoleInterp->result);
  186.     }
  187.     Tcl_Release((ClientData) consoleInterp);
  188.     return TCL_OK;
  189.     
  190.     error:
  191.     if (consoleInterp != NULL) {
  192.         Tcl_DeleteInterp(consoleInterp);
  193.     }
  194.     return TCL_ERROR;
  195. }
  196.  
  197. /*
  198.  *----------------------------------------------------------------------
  199.  *
  200.  * ConsoleOutput--
  201.  *
  202.  *    Writes the given output on the IO channel. Returns count of how
  203.  *    many characters were actually written, and an error indication.
  204.  *
  205.  * Results:
  206.  *    A count of how many characters were written is returned and an
  207.  *    error indication is returned in an output argument.
  208.  *
  209.  * Side effects:
  210.  *    Writes output on the actual channel.
  211.  *
  212.  *----------------------------------------------------------------------
  213.  */
  214.  
  215.     /* ARGSUSED */
  216. static int
  217. ConsoleOutput(instanceData, outFile, buf, toWrite, errorCode)
  218.     ClientData instanceData;        /* Unused. */
  219.     Tcl_File outFile;            /* Output device for channel. */
  220.     char *buf;                /* The data buffer. */
  221.     int toWrite;            /* How many bytes to write? */
  222.     int *errorCode;            /* Where to store error code. */
  223. {
  224.     *errorCode = 0;
  225.     Tcl_SetErrno(0);
  226.  
  227.     if (gStdoutInterp != NULL) {
  228.     TkConsolePrint(gStdoutInterp, outFile, buf, toWrite);
  229.     }
  230.     
  231.     return toWrite;
  232. }
  233.  
  234. /*
  235.  *----------------------------------------------------------------------
  236.  *
  237.  * ConsoleInput --
  238.  *
  239.  *    Read input from the console.  Not currently implemented.
  240.  *
  241.  * Results:
  242.  *    Always returns EOF.
  243.  *
  244.  * Side effects:
  245.  *    None.
  246.  *
  247.  *----------------------------------------------------------------------
  248.  */
  249.  
  250. static int
  251. ConsoleInput(instanceData, inFile, buf, bufSize, errorCode)
  252.     ClientData instanceData;        /* Unused. */
  253.     Tcl_File inFile;            /* Input device for channel. */
  254.     char *buf;                /* Where to store data read. */
  255.     int bufSize;            /* How much space is available
  256.                                          * in the buffer? */
  257.     int *errorCode;            /* Where to store error code. */
  258. {
  259.     return 0;            /* Always return EOF. */
  260. }
  261.  
  262. /*
  263.  *----------------------------------------------------------------------
  264.  *
  265.  * ConsoleClose --
  266.  *
  267.  *    Closes the IO channel.
  268.  *
  269.  * Results:
  270.  *    Always returns 0 (success).
  271.  *
  272.  * Side effects:
  273.  *    Frees the dummy file associated with the channel.
  274.  *
  275.  *----------------------------------------------------------------------
  276.  */
  277.  
  278.     /* ARGSUSED */
  279. static int
  280. ConsoleClose(instanceData, interp, inFile, outFile)
  281.     ClientData instanceData;    /* Unused. */
  282.     Tcl_Interp *interp;    /* Unused. */
  283.     Tcl_File inFile;        /* Input file to close. */
  284.     Tcl_File outFile;        /* Output file to close. */
  285. {
  286.     if (inFile) {
  287.     Tcl_FreeFile(inFile);
  288.     }
  289.     if (outFile && (outFile != inFile)) {
  290.     Tcl_FreeFile(outFile);
  291.     }
  292.     return 0;
  293. }
  294.  
  295. /*
  296.  *----------------------------------------------------------------------
  297.  *
  298.  * ConsoleCmd --
  299.  *
  300.  *    The console command implements a Tcl interface to the various console
  301.  *    options.
  302.  *
  303.  * Results:
  304.  *    None.
  305.  *
  306.  * Side effects:
  307.  *    None.
  308.  *
  309.  *----------------------------------------------------------------------
  310.  */
  311.  
  312. static int
  313. ConsoleCmd(clientData, interp, argc, argv)
  314.     ClientData clientData;        /* Not used. */
  315.     Tcl_Interp *interp;            /* Current interpreter. */
  316.     int argc;                /* Number of arguments. */
  317.     char **argv;            /* Argument strings. */
  318. {
  319.     ConsoleInfo *info = (ConsoleInfo *) clientData;
  320.     char c;
  321.     int length;
  322.     int result;
  323.     Tcl_Interp *consoleInterp;
  324.  
  325.     if (argc < 2) {
  326.     Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
  327.         " option ?arg arg ...?\"", (char *) NULL);
  328.     return TCL_ERROR;
  329.     }
  330.     
  331.     c = argv[1][0];
  332.     length = strlen(argv[1]);
  333.     result = TCL_OK;
  334.     consoleInterp = info->consoleInterp;
  335.     Tcl_Preserve((ClientData) consoleInterp);
  336.     if ((c == 't') && (strncmp(argv[1], "title", length)) == 0) {
  337.     Tcl_DString dString;
  338.     char *wmCmd = "wm title . {";
  339.     
  340.     Tcl_DStringInit(&dString);
  341.     Tcl_DStringAppend(&dString, wmCmd, strlen(wmCmd));
  342.     Tcl_DStringAppend(&dString, argv[2], strlen(argv[2]));
  343.     Tcl_DStringAppend(&dString, "}", strlen("}"));
  344.     Tcl_Eval(consoleInterp, dString.string);
  345.     Tcl_DStringFree(&dString);
  346.     } else if ((c == 'h') && (strncmp(argv[1], "hide", length)) == 0) {
  347.     Tcl_Eval(info->consoleInterp, "wm withdraw .");
  348.     } else if ((c == 's') && (strncmp(argv[1], "show", length)) == 0) {
  349.     Tcl_Eval(info->consoleInterp, "wm deiconify .");
  350.     } else {
  351.     Tcl_AppendResult(interp, "bad option \"", argv[1],
  352.         "\": should be hide, show, or title",
  353.         (char *) NULL);
  354.         result = TCL_ERROR;
  355.     }
  356.     Tcl_Release((ClientData) consoleInterp);
  357.     return result;
  358. } /* ConsoleCmd */
  359.  
  360. /*
  361.  *----------------------------------------------------------------------
  362.  *
  363.  * InterpreterCmd --
  364.  *
  365.  *    This command allows the console interp to communicate with the
  366.  *    main interpreter.
  367.  *
  368.  * Results:
  369.  *    None.
  370.  *
  371.  * Side effects:
  372.  *    None.
  373.  *
  374.  *----------------------------------------------------------------------
  375.  */
  376.  
  377. static int
  378. InterpreterCmd(clientData, interp, argc, argv)
  379.     ClientData clientData;        /* Not used. */
  380.     Tcl_Interp *interp;            /* Current interpreter. */
  381.     int argc;                /* Number of arguments. */
  382.     char **argv;            /* Argument strings. */
  383. {
  384.     ConsoleInfo *info = (ConsoleInfo *) clientData;
  385.     char c;
  386.     int length;
  387.     int result;
  388.     Tcl_Interp *otherInterp;
  389.  
  390.     if (argc < 2) {
  391.     Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
  392.         " option ?arg arg ...?\"", (char *) NULL);
  393.     return TCL_ERROR;
  394.     }
  395.     
  396.     c = argv[1][0];
  397.     length = strlen(argv[1]);
  398.     result = TCL_OK;
  399.     otherInterp = info->interp;
  400.     Tcl_Preserve((ClientData) otherInterp);
  401.     if ((c == 'e') && (strncmp(argv[1], "eval", length)) == 0) {
  402.        result = Tcl_GlobalEval(otherInterp, argv[2]);
  403.         Tcl_AppendResult(interp, otherInterp->result, (char *) NULL);
  404.     } else if ((c == 'r') && (strncmp(argv[1], "record", length)) == 0) {
  405.        Tcl_RecordAndEval(otherInterp, argv[2], TCL_EVAL_GLOBAL);
  406.     result = TCL_OK;
  407.         Tcl_AppendResult(interp, otherInterp->result, (char *) NULL);
  408.     } else {
  409.     Tcl_AppendResult(interp, "bad option \"", argv[1],
  410.         "\": should be eval or record",
  411.         (char *) NULL);
  412.     result = TCL_ERROR;
  413.     }
  414.     Tcl_Release((ClientData) otherInterp);
  415.     return result;
  416. }
  417.  
  418. /*
  419.  *----------------------------------------------------------------------
  420.  *
  421.  * ConsoleDeleteProc --
  422.  *
  423.  *    If the console command is deleted we destroy the console window
  424.  *    and all associated data structures.
  425.  *
  426.  * Results:
  427.  *    None.
  428.  *
  429.  * Side effects:
  430.  *    A new console it created.
  431.  *
  432.  *----------------------------------------------------------------------
  433.  */
  434.  
  435. void 
  436. ConsoleDeleteProc(clientData) 
  437.     ClientData clientData;
  438. {
  439.     ConsoleInfo *info = (ConsoleInfo *) clientData;
  440.  
  441.     Tcl_DeleteInterp(info->consoleInterp);
  442.     info->consoleInterp = NULL;
  443. }
  444.  
  445. /*
  446.  *----------------------------------------------------------------------
  447.  *
  448.  * ConsoleEventProc --
  449.  *
  450.  *    This event procedure is registered on the main window of the
  451.  *    slave interpreter.  If the user or a running script causes the
  452.  *    main window to be destroyed, then we need to inform the console
  453.  *    interpreter by invoking "tkConsoleExit".
  454.  *
  455.  * Results:
  456.  *    None.
  457.  *
  458.  * Side effects:
  459.  *    Invokes the "tkConsoleExit" procedure in the console interp.
  460.  *
  461.  *----------------------------------------------------------------------
  462.  */
  463.  
  464. static void
  465. ConsoleEventProc(clientData, eventPtr)
  466.     ClientData clientData;
  467.     XEvent *eventPtr;
  468. {
  469.     ConsoleInfo *info = (ConsoleInfo *) clientData;
  470.     Tcl_Interp *consoleInterp;
  471.     
  472.     if (eventPtr->type == DestroyNotify) {
  473.         consoleInterp = info->consoleInterp;
  474.         Tcl_Preserve((ClientData) consoleInterp);
  475.     Tcl_Eval(consoleInterp, "tkConsoleExit");
  476.         Tcl_Release((ClientData) consoleInterp);
  477.     }
  478. }
  479.  
  480. /*
  481.  *----------------------------------------------------------------------
  482.  *
  483.  * TkConsolePrint --
  484.  *
  485.  *    Prints to the give text to the console.  Given the main interp
  486.  *    this functions find the appropiate console interp and forwards
  487.  *    the text to be added to that console.
  488.  *
  489.  * Results:
  490.  *    None.
  491.  *
  492.  * Side effects:
  493.  *    None.
  494.  *
  495.  *----------------------------------------------------------------------
  496.  */
  497.  
  498. void
  499. TkConsolePrint(interp, outFile, buffer, size)
  500.     Tcl_Interp *interp;        /* Main interpreter. */
  501.     Tcl_File outFile;        /* Should be stdout or stderr. */
  502.     char *buffer;        /* Text buffer. */
  503.     long size;            /* Size of text buffer. */
  504. {
  505.     Tcl_DString command, output;
  506.     Tcl_CmdInfo cmdInfo;
  507.     char *cmd;
  508.     ConsoleInfo *info;
  509.     Tcl_Interp *consoleInterp;
  510.     int result;
  511.     int fd = (int) Tcl_GetFileInfo(outFile, NULL);
  512.  
  513.     if (interp == NULL) {
  514.     return;
  515.     }
  516.     
  517.     if (fd == 2) {
  518.     cmd = "tkConsoleOutput stderr ";
  519.     } else {
  520.     cmd = "tkConsoleOutput stdout ";
  521.     }
  522.     
  523.     result = Tcl_GetCommandInfo(interp, "console", &cmdInfo);
  524.     if (result == 0) {
  525.     return;
  526.     }
  527.     info = (ConsoleInfo *) cmdInfo.clientData;
  528.     
  529.     Tcl_DStringInit(&output);
  530.     Tcl_DStringAppend(&output, buffer, size);
  531.  
  532.     Tcl_DStringInit(&command);
  533.     Tcl_DStringAppend(&command, cmd, strlen(cmd));
  534.     Tcl_DStringAppendElement(&command, output.string);
  535.  
  536.     consoleInterp = info->consoleInterp;
  537.     Tcl_Preserve((ClientData) consoleInterp);
  538.     Tcl_Eval(consoleInterp, command.string);
  539.     Tcl_Release((ClientData) consoleInterp);
  540.     
  541.     Tcl_DStringFree(&command);
  542.     Tcl_DStringFree(&output);
  543. }
  544.